#lang racket


(require (for-syntax "../base/main.rkt"))

(provide (struct-out proxy)
         define-proxy)


(struct proxy
  (evaluate
   evaluate-toplevel
   
   ; points
   point
   
   ; lines
   arc
   elliptical-arc
   ellipse
   line
   nurbs-curve
   spline
   
   ; surface
   donut
   ngon
   nurbs-surface
   star
   surface
   
   ; solids
   box
   cone
   cone-frustrum
   cylinder
   pyramid
   sphere
   
   ; generic shapes
   circle
   rectangle
   
   ; transformations 
   extrude
   intersect
   join
   loft
   move
   offset
   rotate
   scale
   subtract
   sweep
   thicken
   union
   
   ; lang
   align
   bbox
   on
   par
   view
   
   ; properties
   curve-begin-coord
   curve-end-coord
   
   surface-curvature
   surface-domain

   ; cad
   begin-draw
   begin-undo-mark
   delete-shape
   delete-shapes
   end-draw
   end-undo-mark
   get-shapes
   render-shape
   undo))

(define-syntax (define-proxy stx)
  (syntax-case stx ()
    ((_ name ((method-name args ...) body ...) ...)
     (let ((new-constructor-name (datum->syntax stx (string->symbol (format "new-~A" (syntax->datum #'name)))))
           (make-constructor-name (datum->syntax stx (string->symbol (format "make-~A" (syntax->datum #'name)))))
           (key-names (map
                       (λ (name)
                         (datum->syntax stx (string->keyword (symbol->string name))))
                       (syntax->datum #'(method-name ...))))
           (key-values (map
                        (λ (name val)
                          (list (datum->syntax stx name) (datum->syntax stx val)))
                        (syntax->datum #'(method-name ...))
                        (syntax->datum #'((λ (args ...) body ...) ...)))))
       #`(begin
           (struct name proxy
             ()
             #:constructor-name #,new-constructor-name)
           (define (#,make-constructor-name #,@(apply append (zip key-names key-values)))
             (#,new-constructor-name method-name ...)))))))